<%
'######################################################################
'## ctrl.mail.asp
'## -------------------------------------------------------------------
'## Feature     :   AspBox Mvc Mail Control Block
'## Version     :   v1.0
'## Author      :   Lajox(lajox@19www.com)
'## Update Date :   2014/5/21 15:03
'## Description :   AspBox Mvc Mail Control Block(MVC控制模块之Mail操作)
'## ========================================================================================
'## Examples :
'##     AB.Use "Mvc" : Ctrl.Use "mail"
'##     Dim oMail : Set oMail= Ctrl.Mail
'##     oMail.Object 		= 1 '指定发送邮件组件(1=Jmail,2=Aspemail,3=Cdonts,4=Cdoemail)
'##     oMail.SMTP 			= "smtp.163.com" 'SMTP地址(邮件服务器)
'##     oMail.LoginName		= "******@163.com" '身份验证用户名(邮件服务器登录名)
'##     oMail.LoginPass		= "******" '身份验证密码(邮件服务器登录密码)
'##     oMail.FromMail		= "******@163.com" '发送人邮箱
'##     oMail.FromName 		= "虚幻" '发送人名字信息
'##     oMail.ToMail 		= "******@126.com" '收信人邮件列表
'##     '==使用 oMail.Send 方法
'##     oMail.Subject 		= "邮件标题" '邮件主题
'##     oMail.Content 		= "邮件内容" '邮件内容
'##     oMail.Send 			'执行发送
'##     '==或者使用 oMail.SendMail 方法
'##     '直接这么写:  Call oMail.SendMail("******@126.com","邮件标题","邮件内容")
'##     If oMail.Code = 10000 Then AB.C.Print "邮件发送成功" Else AB.C.Print oMail.Msg
'######################################################################

Class Cls_Ctrl_Mail
	Private s_loginname,s_loginpass,s_smtp,s_fromemail,s_fromname,s_contenttype,s_charset
	Private s_tomail,s_subject,s_content
	Private s_objmail,o_mail,o_cdoConfig
	Private iCount,iCode,sMsg,CodeData

	Private Sub Class_Initialize()
		On Error Goto 0
		s_objmail = 1
		i_count = 0
		iCode = 0
		s_contenttype = "text/html"
		s_charset = AB.CharSet
		Init()
	End Sub

	Private Sub Init()
		AB.Error(10000)			= "邮件发送成功."
		AB.Error(10001)			= "您的服务器不支持该组件."
		AB.Error(10002)			= "发送者地址不能为空."
		AB.Error(10003)			= "发送者姓名不能为空."
		AB.Error(10004)			= "优先级必须为1-5之间的数字."
		AB.Error(10005)			= "发送邮件对象未创建."
		AB.Error(10006)			= "邮件地址不正确."
		AB.Error(10007)			= "SMTP地址为空或不正确."
		AB.Error(10008)			= "没有任何收件人."
		AB.Error(20001)			= "身份验证的用户名不能为空."
		AB.Error(20002)			= "身份验证的密码不能为空."
		AB.Error(30001)			= "邮件发送失败."
		AB.Error(30002)			= "邮件设置参数出错."
		If Err<>0 Then Err.Clear
	End Sub

	Private Sub Class_Terminate()
		If IsObject(o_mail) Then Set o_mail = Nothing
		If IsObject(o_cdoConfig) Then Set o_cdoConfig = Nothing
		If Err<>0 Then Err.Clear
	End Sub

	'设置SMTP邮件服务器地址(可读/可写)
	Public Property Let SMTP(Byval s)
		s_smtp = s
	End Property
	Public Property Get SMTP()
		SMTP = s_smtp
	End Property

	'设置您的邮件服务器登录名(可读/可写)
	Public Property Let LoginName(Byval s)
		s_loginname = s
	End Property
	Public Property Get LoginName()
		LoginName = s_loginname
	End Property

	'设置登录密码(可读/可写)
	Public Property Let LoginPass(Byval s)
		s_loginpass = s
	End Property
	Public Property Get LoginPass()
		LoginPass = s_loginpass
	End Property

	'设置发件人的邮件地址(可读/写)
	Public Property Let FromMail(Byval s)
		s_fromemail = s
	End Property
	Public Property Get FromMail()
		FromMail = s_fromemail
	End Property

	'设置发送人名称(可读/写)
	Public Property Let FromName(Byval s)
		s_fromname = s
	End Property
	Public Property Get FromName()
		FromName = s_fromname
	End Property

	'设置邮件类型(可读/写)
	Public Property Let ContentType(Byval s)
		s_contenttype = s
	End Property
	Public Property Get ContentType()
		ContentType = s_contenttype
	End Property

	'设置编码类型(可读/写)
	Public Property Let Charset(Byval s)
		s_charset = Cstr(s)
	End Property
	Public Property Get Charset()
		Charset = s_charset
	End Property

	'设置选取组件(可读/写) 1=Jmail,2=Aspemail,3=Cdonts,4=Cdoemail
	Public Property Let [Object](Byval s)
		On Error Resume Next
		Select Case LCase(s)
			Case "1","jmail","jmail.message" : s_objmail = "JMail.Message"
			Case "2","aspemail","persits.mailsender" : s_objmail = "Persits.MailSender"
			Case "3", "cdonts","cdonts.newmail" : s_objmail = "CDONTS.NewMail"
			Case "4","cdomail","cdo.message" : s_objmail = "CDO.Message" 'window 2003 new SendMailCom Object
			Case Else : s_objmail = "JMail.Message" : 
		End Select
		Dim arr, newarr, i, ok : newarr = Array()
		arr = Array("JMail.Message","Persits.MailSender","CDONTS.NewMail","CDO.Message")
		AB.Use "A" : newarr = AB.A.Push(newarr, s_objmail)
		For Each i In arr
			If LCase(i)<>LCase(s_objmail) Then newarr = AB.A.Push(newarr, i)
		Next
		ok = False
		For i=0 To UBound(newarr)
			If AB.C.isInstall(newarr(i)) Then
				Set o_mail = Server.CreateObject(newarr(i))
				s_objmail = newarr(i)
				ok = True
				Exit For
			End If
		Next
		If Not ok Then
			AB.Error(10001) = AB.Error(10001) & "("& newarr(0) &")"
			iCode = 10001
		End If
		On Error Goto 0
	End Property
	Public Property Get [Object]()
		Select Case LCase(s_objmail)
			Case "1","jmail","jmail.message" : s_objmail = "JMail.Message"
			Case "2","aspemail","persits.mailsender" : s_objmail = "Persits.MailSender"
			Case "3", "cdonts","cdonts.newmail" : s_objmail = "CDONTS.NewMail"
			Case "4","cdomail","cdo.message" : s_objmail = "CDO.Message"
			Case Else : s_objmail = "JMail.Message"
		End Select
		[Object] = s_objmail
	End Property

	'获取返回信息代码和信息内容(只读)
	Public Property Get Msg()
		sMsg = AB.Error(CLng(iCode))
		Msg = sMsg
	End Property
	Public Property Get Code()
		Code = iCode
	End Property

	'设置收件人的邮件地址(可读/可写)
	Public Property Let ToMail(Byval s)
		s_tomail = s
	End Property
	Public Property Get ToMail()
		ToMail = s_tomail
	End Property

	'设置发送邮件主题(可读/可写)
	Public Property Let Subject(Byval s)
		s_subject = s
	End Property
	Public Property Get Subject()
		Subject = s_subject
	End Property

	'设置发送邮件内容(可读/可写)
	Public Property Let Content(Byval s)
		s_content = s
	End Property
	Public Property Get Content()
		Content = s_content
	End Property

	'检查是否发送成功
	Public Property Get isOk()
		isOk = False
		If iCode=10000 Then isOk = True
	End Property

	Public Sub Send()
		If iCode<>0 and iCode<>10000 Then Exit Sub
		Call SendMail(s_tomail, s_subject, s_content)
		'If iCode <> 10000 Then AB.Error.Raise iCode
	End Sub

	Public Sub SendMail(Byval email,Byval subject,Byval content)
		On Error Resume Next
		If iCode<>0 and iCode<>10000 Then Exit Sub
		If iCode=10000 Then iCode=0
		If Not IsArray(email) Then : If IsNull(email) Or Trim(email)="" Then email = s_tomail : End If
		If AB.C.IsNul(email) Then email = s_tomail
		If subject="" or IsNull(subject) Then subject = s_subject
		If content="" or IsNull(content) Then content = s_content
		If AB.C.IsNul(email) Then Exit Sub
		If Trim(s_objmail&"") <> "" Then
			Select Case LCase(s_objmail)
				Case "1","jmail","jmail.message"
					Jmail email,subject,content
				Case "2", "cdonts","cdonts.newmail"
					Cdonts email,subject,content
				Case "3","aspemail","persits.mailsender"
					Aspemail email,subject,content
				Case "4","cdomail","cdo.message"
					CDOMessage email,subject,content
				Case Else
					iCode = 10005
			End Select
		Else
			iCode = 10005
		End If
		'If iCode <> 10000 Then AB.Error.Raise iCode
		On Error Goto 0
	End Sub

	Private Sub Jmail(Byval email,Byval subject,Byval content)
		On Error Resume Next
		If Not AB.C.IsInstall("JMail.Message") Then : iCode = 10001 : Exit Sub : End If
		If Not AB.C.Has(s_smtp) Then : iCode = 10007 : Exit Sub : End If
		If Not AB.C.Has(s_fromemail) Then : iCode = 10002 : Exit Sub : End If
		If Not AB.C.Has(s_loginname) Then : iCode = 20001 : Exit Sub : End If
		If Not AB.C.Has(s_loginpass) Then : iCode = 20002 : Exit Sub : End If
		If Not AB.C.Has(email) Then : iCode = 10008 : Exit Sub : End If
		If Not AB.C.Has(subject) Then subject="无主题."
		Dim i: AB.Use "a"
		Dim arrMail, arrName : arrMail = MailArray(email,0) : arrName = MailArray(email,1)
		If IsArray(arrMail) and AB.A.Len(arrMail)>0 Then '收信人
			For i = 0 to UBound(arrMail)
				If Trim(arrName(i))<>"" Then
					o_mail.AddRecipient arrMail(i), arrName(i)
				Else
					o_mail.AddRecipient arrMail(i)
				End If
			Next
		End If
		If o_mail.Recipients.Count=0 Then : iCode = 10008 : Exit Sub : End If
		'o_mail.AddRecipientcc "" '抄送收件人
		o_mail.Silent = True 'jmail不会抛出例外错误
		o_mail.Charset = s_charset '邮件编码
		o_mail.ContentType = s_contenttype '邮件正文格式(缺省"text/plain",HTML格式为"text/html")
		o_mail.From = s_fromemail '发信人Email
		o_mail.FromName = s_fromname '发信人姓名
		'o_mail.ReplyTo = FromMail '指定别的回信地址
		'o_mail.MailDomain = Right(FromMail,InStr(FromMail,"@")) '域名（如果用“name@domain.com”这样的用户名登录时,请指明domain.com 
		o_mail.MailServerUserName = s_loginname '您的邮件服务器登录名
		o_mail.MailServerPassword = s_loginpass '登录密码
		o_mail.Subject = subject '主题
		'contentId = o_mail.AddAttachment(filename, True)
		' 加入附件【变量filename：附件文件的绝对地址，确保用户IUSR_机器名有访问的权限】【参数设置:是(True)否(False)为Inline方式】
		o_mail.HTMLBody = content '邮件主体（HTML(注意信件内链接附件的方式)）
		' e.g.  o_mail.HTMLBody = "<html><body><center>点击这里<a href='cid:" & contentId & "' >[附件文件]</a>将文件保存</center></body></html>"
		'o_mail.Body = "" '邮件主体（文本部分）
		o_mail.Priority = 1 '邮件等级，1为加急，3为普通，5为低级 (默认值3)
		'o_mail.Logging = True '是否使用日志
		If Err<>0 Then
			iCode = 30002
		Else
			o_mail.Send s_smtp
			o_mail.ClearRecipients()
			If Err<>0 Then
				iCode = 30001
			Else
				iCount = iCount + 1
				iCode = 10000
			End If
		End If
		o_mail.close()
		Set o_mail = Nothing
		On Error Goto 0
	End Sub

	Private Sub Aspemail(Byval email,Byval subject,Byval content)
		'On Error Resume Next
		If Not AB.C.IsInstall("Persits.MailSender") Then : iCode = 10001 : Exit Sub : End If
		o_mail.From = s_fromemail '发件人地址
		o_mail.FromName = s_fromname '发件人姓名,可选
		o_mail.Subject = subject '邮件主题
		o_mail.Body = content '邮件内容
		'o_mail.AddCC "" '抄送
		o_mail.Charset = s_charset '设置字符编码
		o_mail.IsHTML = True '是否可以发HTML语言格式的邮件
		o_mail.username = s_loginname	'服务器上有效的用户名
		o_mail.password = s_loginpass	'服务器上有效的密码
		o_mail.Priority = 1 '邮件优先级1-5, 1为最高
		o_mail.Host = s_smtp '邮件服务器
		'o_mail.Port = 25 ' 该项可选.端口25是默认值
		'o_mail.AddAttachment filepath '添加附件
		'o_mail.AddAddress email,"" '发送到的邮箱地址(Address As String, Optional Name = "")
		Dim i: AB.Use "a"
		Dim arrMail, arrName : arrMail = MailArray(email,0) : arrName = MailArray(email,1)
		If IsArray(arrMail) and AB.A.Len(arrMail)>0 Then '收信人
			For i = 0 to UBound(arrMail)
				If Trim(arrName(i))<>"" Then
					o_mail.AddAddress arrMail(i), arrName(i)
				Else
					o_mail.AddAddress arrMail(i)
				End If
			Next
		End If
		If Err<>0 Then
			iCode = 30002
		Else
			o_mail.Send
			If Err<>0 Then
				iCode = 30001
			Else
				iCount = iCount + 1
				iCode = 10000
			End If
		End If
		On Error Goto 0
	End Sub

	Private Sub Cdonts(Byval email,Byval subject,Byval content)
		On Error Resume Next
		If Not AB.C.IsInstall("CDONTS.NewMail") Then : iCode = 10001 : Exit Sub : End If
		o_mail.From = s_fromemail
		o_mail.Subject = subject '信件主题
		'o_mail.Cc = "" '抄送
		'o_mail.Bcc = "" '密送
		o_mail.BodyFormat = 0 '可以包含html代码
		o_mail.MailFormat = 0 '说明是以MIME发送
		o_mail.Importance = 2 '设置优先级，0-不重要，1-一般，2-重要
		o_mail.Body = content '信件正文
		'o_mail.AttachFile path,filename '附件
		'o_mail.To = email '发送到的邮箱地址
		Dim i: AB.Use "a"
		Dim arrMail, arrName : arrMail = MailArray(email,0) : arrName = MailArray(email,1)
		If Err<>0 Then
			iCode = 30002
		Else
			If IsArray(arrMail) and AB.A.Len(arrMail)>0 Then '收信人
				For i = 0 to UBound(arrMail)
					o_mail.To = arrMail(i)
					o_mail.Send
				Next
			End If
			If Err<>0 Then
				iCode = 30001
			Else
				iCount = iCount + 1
				iCode = 10000
			End If
		End If
		On Error Goto 0
	End Sub

	Private Sub CDOMessage(Byval email,Byval subject,Byval content)
		On Error Resume Next
		'If Not AB.C.IsInstall("CDO.Message") Then AB.C.Put "发送失败!原因：服务器不支持组件(CDO.Message)"
		If Not AB.C.IsInstall("CDO.Message") Then : iCode = 10001 : Exit Sub : End If
		If Not IsObject(o_cdoConfig) Then Call CreatCDOConfig()
		If Err<>0 Then : iCode = 30001 : Exit Sub : End If
		Set o_mail = Server.CreateObject("CDO.Message")
		With o_mail
			Set .Configuration = o_cdoConfig
			.BodyPart.Charset = s_charset 	'邮件内容编码
			.From = s_fromemail
			'.To = email '发送到的邮箱地址
			.Subject = subject
			'.TextBody = content '使用普通的文本格式发送邮件(不支持HTML)
			.htmlBody = content '使用HTML格式发送内容
			'.AddAttachment filepath '添加附件
		End With
		Dim i: AB.Use "a"
		Dim arrMail, arrName : arrMail = MailArray(email,0) : arrName = MailArray(email,1)
		If Err<>0 Then
			iCode = 30002
		Else
			If IsArray(arrMail) and AB.A.Len(arrMail)>0 Then '收信人
				For i = 0 to UBound(arrMail)
					If Trim(arrName(i))<>"" Then
						o_mail.To = """"& arrName(i) &""" <"& arrMail(i) &">"
					Else
						o_mail.To = arrMail(i)
					End If
					o_mail.Send
				Next
			End If
			If Err<>0 Then
				iCode = 30001
			Else
				iCount = iCount + 1
				iCode = 10000
			End If
		End If
		Set o_cdoConfig = Nothing
		On Error Goto 0
	End Sub

	Private Sub CreatCDOConfig()
		On Error Resume Next
		Dim Sch, cdoSendUsingMethod, cdoSMTPServer, cdoSMTPServerPort, cdoSMTPConnectionTimeout, cdoSMTPAuthenticate, cdoSendUserName, cdoSendPassword
		Dim cdoSMTPAccountName, cdoSendEmailAddress, cdoSMTPUserReplyEmailAddress
		Dim cdoBasic, cdoSendUsingPort
		sch = "http://schemas.microsoft.com/cdo/configuration/"
		cdoSendUsingMethod = sch & "sendusing"
		cdoSMTPServer = sch & "smtpserver"
		cdoSMTPServerPort = sch & "smtpserverport"
		cdoSMTPConnectionTimeout = sch & "smtpconnectiontimeout"
		cdoSMTPAuthenticate = sch & "smtpauthenticate"
		cdoSMTPAccountName = sch & "smtpaccountname"
		cdoSendEmailAddress = sch & "sendemailaddress"
		cdoSMTPUserReplyEmailAddress = sch & "smtpuserreplyemailaddress"
		cdoSendUserName = sch & "sendusername"
		cdoSendPassword = sch & "sendpassword"
		cdoBasic = 1
		cdoSendUsingPort = 2
		Set o_cdoConfig = Server.CreateObject("CDO.Configuration")
		With o_cdoConfig.Fields 
			.Item(cdoSendUsingMethod) = cdoSendUsingPort
			.Item(cdoSMTPServer) = "smtp.163.com" 			'<smtp邮件发送服务器>
			.Item(cdoSMTPServerPort) = 25  
			.Item(cdoSMTPConnectionTimeout) = 10
			.Item(cdoSMTPAuthenticate) = cdoBasic
			.Item(cdoSMTPAccountName) = s_fromname 			'发件人姓名 "My Name"
			.Item(cdoSendEmailAddress) = s_fromemail 		'发件人地址 """MySelf"" <example@example.com>"
			'.Item(cdoSMTPUserReplyEmailAddress) = "" 		'抄送 """Another"" <another@example.com>"
			.Item(cdoSendUserName) = s_loginname 			'<服务器登录名>
			.Item(cdoSendPassword) = s_loginpass 			'<服务器登录密码>
			.Update 
		End With
		On Error Goto 0
	End Sub

	'@ *****************************************************************************************
	'@ 过程名:  Ctrl.Mail.MailArray(Byval mails, Byval p)
	'@ 返  回:  Array (数组)
	'@ 作  用:  以数组形式获取收信人地址或姓名.[当p=0时返回(收信人地址)数组; 当当p=1时返回(收信人姓名)数组]
	'==DESC=====================================================================================
	'@ 参数 mails : String (字符串) 或 Array (数组) 收件人
	'@ 参数 p : 0 或 1
	'==DEMO=====================================================================================
	'@ ----收件人可以是字符串形式(String)；有如下格式字---
	'@   "网易"<test1@163.com>;"腾讯"<test2@qq.com>;
	'@   "网易"<test1@163.com>;
	'@   test1@163.com;test2@qq.com;
	'@   <test1@163.com>;<test2@qq.com>;
	'@ ----也可以用数组(Array)表示---
	'@   Array("test1@163.com","test2@qq.com")
	'@   Array("'网易'<test1@163.com>","'腾讯'<test2@qq.com>")
	'@ =========Demo========
	'@ AB.Use "Mvc" : Ctrl.Use "mail"
	'@ Dim oMail : Set oMail= Ctrl.Mail
	'@ Dim mails
	'@ 'mails = """网易""<test1@163.com>;""腾讯""<test2@qq.com>;"
	'@ mails = Array("'网易'<test1@163.com>", "'腾讯'<test2@qq.com>")
	'@ oMail.Object 		= 1 '指定发送邮件组件(1=Jmail,2=Aspemail,3=Cdonts,4=Cdoemail)
	'@ oMail.SMTP 			= "smtp.163.com" 'SMTP地址(邮件服务器)
	'@ oMail.LoginName		= "send@163.com" '身份验证用户名(邮件服务器登录名)
	'@ oMail.LoginPass		= "******" '身份验证密码(邮件服务器登录密码)
	'@ oMail.FromMail		= "send@163.com" '发送人邮箱
	'@ oMail.FromName 		= "虚幻" '发送人名字信息
	'@ 'oMail.ToMail 		= "test1@126.com" '收信人邮件列表
	'@ oMail.ToMail 		= mails '收信人邮件列表
	'@ oMail.Subject 		= "邮件标题" '邮件主题
	'@ oMail.Content 		= "邮件内容" '邮件内容
	'@ oMail.Send 			'执行发送
	'@ If oMail.Code = 10000 Then AB.C.Print "邮件发送成功" Else AB.C.Print oMail.Msg
	'@ Dim arrMailAddress : arrMailAddress = Ctrl.Mail.MailArray(mails,0) '返回数组(收信人地址)
	'@ Dim arrMailName : arrMailName = Ctrl.Mail.MailArray(mails,1) '返回数组(收信人姓名)
	'@ ab.trace arrMailAddress
	'@ ab.trace arrMailName
	'@ *****************************************************************************************

	Public Function MailArray(Byval mails, Byval p)
		On Error Resume Next
		Dim a(),b()
		Dim sMail,arrMail,i,k : sMail = mails
		Dim s1,s2,t1,t2,temp
		If Not IsArray(sMail) Then : If IsNull(sMail) Or Trim(sMail)="" Then : MailArray = a : Exit Function : End If : End If
		If AB.C.IsNul(sMail) Then : MailArray = a : Exit Function : End If
		If IsArray(sMail) Then
			arrMail = sMail
		Else
			If InStr(sMail,";")>0 Then
				If InStrRev(sMail,";")=Len(sMail) Then sMail = Left(sMail,len(sMail)-1)
				arrMail = Split(sMail,";")
			Else
				arrMail = Array(sMail)
			End If
		End If
		If IsArray(arrMail) Then
			k = 0
			For i=0 to UBound(arrMail)
				If Not IsNull(arrMail(i)) and Trim(arrMail(i))<>"" Then
					temp = Trim(arrMail(i))
					Dim re : Set re = New RegExp
					re.IgnoreCase = True
					re.Global = True
					re.Pattern = "^([^<>]*<)?([^<>]*)[>]?":t1 = re.replace(temp,"$2")
					re.Pattern = "^\s*(""|')?\s*([^\1]*?)\s*\1.*": t2 = re.replace(temp,"$2")
					Set re = Nothing
					If Instr(temp,"<")<=0 Then s1 = temp Else s1 = Trim(t1)
					s2 = Trim(t2)
					If s1 <> "" Then
						'If AB.C.Test(s1,"email") Then
							Redim Preserve a(k)
							Redim Preserve b(k)
							a(k) = s1
							b(k) = s2
							k = k + 1
						'End If
					End If
				End If
			Next
		End If
		Select Case LCase(p&"")
			Case "1" MailArray = b
			Case Else MailArray = a
		End Select
		On Error Goto 0
	End Function
End Class
%>